home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1991: Code Warrior / bincue / Code Warrior.bin / Tools & Apps (Moof!) / Networking & Communications / The NetWork Project / Examples (Sources) / RemoteJob.p < prev    next >
Encoding:
Text File  |  1991-06-17  |  16.4 KB  |  597 lines  |  [TEXT/MPS ]

  1. { Copyright 1989-1991 The NetWork Project, StatLab Heidelberg
  2. © Copyright 1989-1991 Günther Sawitzki, Heidelberg. All rights reserved. 
  3. }
  4.  
  5. program RemoteJob; {0.1d5}
  6.  
  7. uses     
  8.     Errors,
  9.     Types, QuickDraw, Menus,
  10.     Memory,
  11.     Fonts,Windows,TextEdit,Dialogs,
  12.     OsUtils,Files,
  13.     Events,Desk,
  14.     NetWork, NetWorkLookup,Traps,
  15.     ObjIntf,SchedulerUnit,PasLibIntf;
  16.  
  17. {-----------------------------------------------------------------------}
  18. {remote launching example. This can be used to do a remote launch of 
  19. pre-NetWork programs. A simple use would be to have a remote MPW
  20. cooperating on a build.
  21.  
  22. The sending part looks for a file named remote.job in the system folder.
  23. If the file exists, its data fork is transferred according to the user 
  24. selected settings.
  25.  
  26. Upon receipt of a message, the receiving part stores the file as file 
  27. UserStartUp•Remote.Job in the system folder, and tries to launch the 
  28. proper target, eg. MPW.
  29.  
  30. To use it, place a copy of MPW and a suitable startup file in the
  31. NetWork folder on the receiving machine.
  32.  
  33. • under construction • Alpha release notes:
  34.  
  35. spare does a lot of debugging. should be used only with source in hand.
  36.  
  37. To do:
  38. Which of the ping games should be allowed ?
  39. Provide prototype for collision detection,improper format handling.
  40. File error handling.
  41. System 7 support for reduced MPW shell (to be introduced with ETO 3).
  42.  
  43. Done:
  44.  
  45. 0.1d4    ##
  46. 0.1d3    adapted to event-based scheduler
  47. 0.1d2    default received file type to TEXT
  48. }
  49.  
  50. {=============================================================================}
  51. {    our message header format    }
  52.  
  53. const cFormatVersion='VS 1';    {good habit: keep a version stamp around while
  54.                                 you are experimenting}
  55.  
  56. type 
  57.     tHeaderPtr=^tHeader;
  58.     tHeader=record
  59.         idStamp:longint;
  60.         signature:longint;    {whom shall we activate ?}
  61.         whereMode:integer;    {code for determining the target system.
  62.                             see MsgEvaluation}
  63.     end;
  64.  
  65. var sendHeader    :tHeader;        {we keep one copy around to define defaults}
  66.  
  67. {=============================================================================}
  68. {    our message handlers. We will work with static message handler, so we
  69. instantiate one of each and keep it around all the time}
  70.  
  71. {-----------------------------------------------------------------------------}
  72. {    sending part: generate a task if a command is given or a commenand file
  73.     is around    }
  74.  
  75. type
  76.     tRemoteGenerator= Object(tTaskGenerator)
  77.         function tRemoteGenerator.newTask(var msg:MsgPtr):boolean; override;
  78.     end;
  79.  
  80. var RemoteGenerator    : tRemoteGenerator;
  81.  
  82. {-----------------------------------------------------------------------------}
  83. {    recipients part: a message is considered usable if the header has the
  84.     correct format id. MsgEvaluation stores the information to a file, and
  85.     sends an (empty) message to launch the recipient.}
  86.  
  87. type 
  88.     tRemoteHandler = Object(tTaskhandler)
  89.         FormatVersion:longint;                        {we can only use messages of this version}
  90.         procedure tRemoteHandler.init; override;    {sets FormatVersion to cFormatVersion} 
  91.         function tRemoteHandler.MsgUsable(var msg:msgPtr):boolean; override;
  92.         procedure tRemoteHandler.MsgEvaluation(var msg:msgPtr); override;
  93.     end;
  94.     
  95. var RemoteHandler : tRemoteHandler;
  96.  
  97.  
  98. {=============================================================================}
  99. {    global constants and variables    }
  100.  
  101. const    
  102.     cMaxJobFileSize        = 8*1024;    {to improve: work with any file sizes}
  103.  
  104.     {default file names}
  105.     cJobFileToSend        ='Remote.Job';
  106.     cJobFileReceived    ='UserStartUp•Remote.Job';
  107. var 
  108.     JobFileToSend,
  109.     JobFileReceived        : str255;
  110.  
  111.     done, front            : boolean; 
  112.     mode                : integer;
  113.     gSleep                : longint;
  114.     
  115.     gTextValid            : boolean;
  116.     gTextToSend         : Str255;
  117.         {if gTextValid is true, gTextToSend holds a text to be transmitted}
  118.  
  119.  
  120.     {=============================================================================}
  121.     {    Application layer    }
  122.  
  123.     {-----------------------------------------------------------------------------}
  124.     {    File access routines    }
  125.  
  126.  
  127.  
  128. function CheckStatus(whichFile:str255):osErr;
  129.  
  130.         {Return NoErr if a file named whichFile exists and is ready for sending.
  131.         This is used to check for the existence of cJobFileToSend. 
  132.         To do: it should guarantee that the file is not open for write
  133.         in order to guarantee that writing of the job file is finished. }
  134.         
  135. var myfinfo:Finfo;
  136. begin
  137.     CheckStatus:=GetFInfo(whichFile,0,myfinfo);
  138. end;
  139.  
  140.  
  141. procedure ReadJobFile(whichFile:str255;var filesize:longint;var where:ptr);
  142.  
  143.         {Open a file and read the contents to the buffer indicated by
  144.         where. Return the number of bytes read. Delete the file.}
  145.         
  146. VAR
  147.     InputFile: FILE;
  148.     myerr:osErr;
  149. begin
  150.     if spare then debugstr(concat('Start ReadJobFile ',whichfile,' Type g to continue.'));
  151.     filesize:=0; 
  152.     reset(InputFile, whichfile); 
  153.     if (ioresult=0) & (where<>nil) then 
  154.     begin
  155.         filesize:= byteread(InputFile, where^, GetPtrSize(where));
  156.         myErr:=ioResult;
  157.         if spare & (myerr<>noErr) then debugstr('error on read');
  158.         close(inputfile);
  159.         PLPurge(JobFileToSend);
  160.     END;
  161. end;
  162.  
  163.  
  164. procedure WriteJobFile(whichFile:str255;filesize:longint; where:ptr);
  165.  
  166.     {Create a file and write the contents to the buffer indicated by
  167.     where. Set type and crator as for an MPW text file. close the file.}
  168.  
  169. const cDefaultVolRef=0;
  170. VAR
  171.     OutputFile: FILE;
  172.     myErr:Oserr;
  173.     fndrinfo:Finfo;
  174. begin
  175.     if spare then debugstr(concat('Start WriteJobFile: ',whichfile,' Type g to continue.'));
  176.     rewrite(OutputFile, whichfile); 
  177.     if ioresult=0 then {to improve:handle multiple files}
  178.     begin
  179.         filesize:=bytewrite(OutputFile, where^, filesize);
  180.         close(OutputFile);
  181.         if getfinfo(JobFileReceived, cDefaultVolRef, fndrinfo)=NoErr then
  182.         begin
  183.             fndrinfo.fdtype := 'TEXT';    {clame it is from MPW, as default}
  184.             fndrinfo.fdCreator := 'MPS ';
  185.             if  Setfinfo(JobFileReceived, cDefaultVolRef, fndrinfo) <> noErr then;
  186.         END;
  187.  
  188.     END;
  189. end;
  190.  
  191.  
  192. {=============================================================================}
  193. {    NetWork specific part of layer    }
  194.  
  195.  
  196. {-----------------------------------------------------------------------------}
  197. const    {several modes to identify the machine on which a process shall be launched.
  198.     -- to experiment with }
  199.  
  200.     LocalMode    =1;    {launch on local machine}
  201.     RandomMode    =2;    {launch on a random machine}
  202.     NextMode    =3;    {launch on the next machine}
  203.     BroadcastMode=4;{launch on all machines}
  204.  
  205.  
  206. function newAddr(var addr:longint;mode:integer):boolean;
  207. begin    newAddr:=true;{default}
  208.     case Mode of
  209.         1 : addr := 0; { local }
  210.         2 : begin addr := NlRandom; if addr=0 then newAddr:=false;end;
  211.         3 : begin
  212.             if addr<0 then addr:=NLRandom else
  213.             addr := NlNext (addr);
  214.             if addr=0 then newAddr:=false;
  215.         end; 
  216.         4 : addr := -1; { broadcast }
  217.     end;
  218. end;
  219.  
  220.  
  221. {=============================================================================}
  222. {    message handler implementation    }
  223.  
  224. {-----------------------------------------------------------------------------}
  225. {    recipients part    }
  226.  
  227. var     MessageToPass    :msgRec;    {allocate static space to avoid heap fragmentation}
  228.  
  229.  
  230. procedure tRemoteHandler.init; override;    {sets FormatVersion to cFormatVersion} 
  231. begin
  232.     inherited init;
  233.     FormatVersion:=longint(cFormatVersion);
  234. end;
  235.  
  236. function tRemoteHandler.MsgUsable(var msg:msgPtr):boolean; override;
  237. var oksofar:boolean;
  238. begin
  239.     if spare then debugstr('RemotJob MsgUsable. Type g to continue.');
  240.     with  tHeaderPtr(msg^.MsgPrioPtr)^ do
  241.     oksofar:=(idStamp=FormatVersion);    {have we got the correct version?}
  242.     if oksofar then with msg^ do  
  243.          MsgCorePtr:=NewCorePtr(MsgCoreSize);        {to do: check size}
  244.     stamp(msg);
  245.     MsgUsable:=oksofar;
  246. end;
  247.  
  248.  
  249. procedure tRemoteHandler.MsgEvaluation(var msg:msgPtr);override;
  250. var NewMsg : MsgPtr; 
  251. begin
  252.     if spare then debugstr('RemotJob MsgEvaluation. Type g to continue.');
  253.  
  254.     {store the information as a file}
  255.     with msg^do
  256.     if (MsgCoreSize>0) & (MsgCorePtr<>nil) then writeJobFile(JobFileReceived,MsgCoreSize,MsgCorePtr);
  257.  
  258.     {now find the adressee}
  259.  
  260.     with tHeaderPtr(msg^.MsgPrioPtr)^,MessageToPass do
  261.     begin
  262.         {determine whom we should we call, using the header information}
  263.         MsgDest.p := signature;
  264.         if NewAddr(MsgDest.a, whereMode ) then begin
  265.  
  266.             MsgReply:=MsgSource; {we are just the mail. all results & complaints to sender please}
  267.  
  268.             NewMsg:=@MessageToPass;
  269.             {all other fields 0 -- does not work when compiled with -u option}
  270.             NetWorkScheduler.SendMessage(NewMsg);     {launch it}
  271.         end else if spare then debugstr('no partner.  Type g to continue.');
  272.         {leave all error handling to the scheduler}
  273.     end;
  274.     {Scheduler.HandleError(pUndefined,DisposMsg(msg));}
  275. end;
  276.  
  277.  
  278. {-----------------------------------------------------------------------------}
  279. {    sending part: we generate a task    }
  280.  
  281.  
  282. function tRemoteGenerator.newTask(var msg:MsgPtr):boolean; override;
  283. var 
  284.     oktosend:boolean;
  285. begin
  286.     if spare then debugstr('tRemoteGenerator.newTask start;g');
  287.  
  288.     if not(gTextValid) & (CheckStatus(JobFileToSend)<>noErr) then okToSend:=false
  289.     else begin
  290.         with msg^ do
  291.         begin
  292.             okToSend:= NewAddr(MsgDest.a,mode);
  293.             if okToSend then begin 
  294.                 if gTextValid then begin {messages on the fly are sent first}
  295.                     MsgCoreSize    :=length(gTextToSend);
  296.                     MsgCorePtr    :=NewCorePtr(MsgCoreSize);
  297.                     BlockMove(@gTextToSend[1],MsgCorePtr,MsgCoreSize);
  298.                     gTextValid    :=false;
  299.                 end else begin {no message on the fly, hence it must be a file}
  300.                     MsgCoreSize    :=cMaxJobFileSize;        {to improve: take real file size}
  301.                     MsgCorePtr    :=NewCorePtr(MsgCoreSize);
  302.                     ReadJobFile(JobFileToSend,MsgCoreSize,MsgCorePtr);
  303.                 end;
  304.                 if MsgCorePtr=nil then okToSend:=false
  305.                 else begin
  306.                     MsgPrioSize    :=sizeof(SendHeader);
  307.                     MsgPrioPtr    :=NewPrioPtr(MsgPrioSize);
  308.                     if MsgPrioPtr=nil then okToSend:=false {overrun or out of memory}
  309.                     else
  310.                     tHeaderPtr(MsgPrioPtr)^:=SendHeader;
  311.                 end;
  312.             end;
  313.         end;
  314.         if okToSend then begin 
  315.             Stamp(msg);
  316.             NewTask:=true;        
  317.             if spare then debugstr('tRemoteGenerator.newTask ok;g');
  318.         end else NewTask:=false;
  319.     end;
  320. end;
  321.  
  322.     {=============================================================================}
  323.     {    general routines    }
  324.  
  325.  
  326. PROCEDURE InitToolBox;    
  327. VAR
  328.     i : integer;
  329.     p : GrafPtr;
  330.     m : MenuHandle;
  331.  
  332. BEGIN
  333.     MaxApplZone;
  334.     FOR i := 1 TO 10 DO
  335.     MoreMasters;
  336.     InitGraf(@thePort);                {initialize QuickDraw}
  337.     InitFonts;                           {initialize Font Manager}
  338.     InitWindows;                       {initialize Window Manager}
  339.     InitMenus;                           {initialize Menu Manager}
  340.     TEInit;                            {initialize TextEdit}
  341.     InitDialogs(NIL);                   {initialize Dialog Manager}
  342.     InitCursor;                        {call QuickDraw to make cursor (pointer) an arrow}
  343.  
  344.     m := GetMenu (256);
  345.     AddResMenu (m, 'DRVR');
  346.     InsertMenu (m, 0);
  347.     m := GetMenu (257); InsertMenu (m, 0);
  348.     m := GetMenu (258); InsertMenu (m, 0);
  349.     DrawMenuBar;
  350.  
  351. END;
  352.  
  353.  
  354. {    Handle the about alert. Stolen from and © by J. Lindenberg, Karlsruhe 1989    }
  355.  
  356. {and here again we do the job the toolbox programmers should have done…}
  357.  
  358. function ModalFilter (dialog : DialogPtr; var ev : EventRecord; 
  359. var itemHit : integer) : boolean;
  360. begin
  361.     ModalFilter := false;
  362.     if ev.what = keydown then 
  363.     case BAnd (ev.message, 255) of
  364.         ord ('Q'): if (BAnd (ev.modifiers, cmdKey) <> 0) then begin
  365.             itemhit := cancel; ModalFilter := true;
  366.         end;
  367.         ord ('.'): begin itemhit := cancel; ModalFilter := true; end;
  368.         13 : begin itemhit := OK; modalfilter := true; end;
  369.     end;
  370. end;
  371.  
  372.  
  373. procedure About;
  374. begin
  375.     if Alert (256, @ModalFilter) = Ok then;
  376. end;
  377.  
  378.  
  379. {=============================================================================}
  380. {    set signature and names of task files    }
  381.  
  382. procedure SetNames;
  383. const     cSignature=3;
  384.     cJobFileToSend=6;
  385.     cJobFileReceived=8;
  386. var d : DialogPtr; n : integer; s : Str255; 
  387.  
  388. procedure SetMyDialog(item:integer;info:str255);
  389. var t : integer;h : Handle; box : Rect;
  390. begin
  391.     GetDItem (d, item, t, h, box);
  392.     SetIText (h, info); 
  393. end;
  394.  
  395. function GetMyDialog(item:integer):str255;
  396. var t : integer;h : Handle; box : Rect;
  397. begin
  398.     GetDItem (d, item, t, h, box);
  399.     GetIText (h, GetMyDialog); 
  400. end;
  401.  
  402. begin
  403.     d := GetNewDialog (258, nil, WindowPtr (-1));
  404.  
  405.     SetMyDialog(cJobFileToSend,JobFileToSend);
  406.     SetMyDialog(cJobFileReceived,JobFileReceived);
  407.  
  408.     s := '????'; BlockMove (@SendHeader.signature, @s[1], 4);
  409.     SetMyDialog(cSignature,s);
  410.     SelIText (d, cSignature, 0, 32767);
  411.  
  412.     repeat
  413.         ModalDialog (nil, n);
  414.         s:=GetMyDialog (cSignature);
  415.     until (n = cancel) | ((n=ok) & (length (s) = 4));
  416.  
  417.     if n = Ok then begin
  418.         {if it is ok, s contains the recent signature}
  419.         BlockMove (@s[1], @SendHeader.signature, 4);
  420.         JobFileToSend:=GetMyDialog (cJobFileToSend);
  421.         JobFileReceived:=GetMyDialog (cJobFileReceived );
  422.     end;
  423.     DisposDialog (d);
  424. end;
  425.  
  426.  
  427. procedure SendOnTheFly;
  428.     {get a command by dialog, create a message and send it.
  429.     This is an example of forcing a new task generation.}
  430.  
  431. var d : DialogPtr; n, t : integer;  h : Handle; box : Rect;
  432.     tempAddr:MsgAddr;
  433. begin
  434.     d := GetNewDialog (259, nil, WindowPtr (-1));
  435.  
  436.     repeat
  437.         ModalDialog (nil, n);
  438.     until (n = ok) | (n=cancel);
  439.     if n = Ok then begin
  440.  
  441.         GetDItem (d, 3, t, h, box);
  442.         GetIText (h, gTextToSend);     {get the text to our buffer}
  443.         gTextValid :=true;            {yes, the information is valid}
  444.         
  445.         tempAddr    := NetWorkScheduler.PrevDest;
  446.         NetWorkScheduler.DoNewTask(tempAddr,NetWorkScheduler.MyTransport);
  447.                                     {get the scheduler to fill all defaults, and call
  448.                                     newTask}
  449.     end;
  450.     DisposDialog (d);
  451. end;
  452.  
  453.  
  454. {=============================================================================}
  455. {    menu handling    }
  456.  
  457. procedure DoMenu (menu : Point);
  458. var  s : Str255;
  459. begin
  460.     case menu.v of
  461.         256 : { apple menu }
  462.         if menu.h = 1 then About
  463.         else begin
  464.             GetItem (GetMHandle (256), menu.h, s);
  465.             CheckError ('OpenDeskAcc', OpenDeskAcc (s));
  466.         end;
  467.         257 : {file and commands}
  468.         case menu.h of
  469.             1 : SetNames;
  470.             3 : SendOnTheFly;
  471.             4 : done := true;
  472.         end;
  473.         258 : {sendmode}
  474.         begin
  475.             CheckItem (GetMHandle (258), mode, false);    {uncheck old}
  476.             mode := menu.h;
  477.             CheckItem (GetMHandle (258), mode, true);     {check new}
  478.         end;
  479.     end;
  480.     HiliteMenu (0);
  481. end;
  482.  
  483.  
  484.  
  485.  
  486. {=============================================================================}
  487. {    main event    }
  488.  
  489. procedure HandleEvents;
  490. var w : windowPtr;
  491.     ev : EventRecord; 
  492. begin
  493.     if WaitNextEvent (EveryEvent, ev, gSleep, nil) then
  494.     case ev.what of
  495.         mouseDown : case FindWindow (ev.where, w) of
  496.             inMenuBar :     DoMenu (Point (MenuSelect (ev.where)));
  497.             inSysWindow :    SystemClick (ev,w);
  498.         end;
  499.         keyDown : if BAnd (ev.modifiers, cmdKey) <> 0 then
  500.         DoMenu (Point (MenuKey (chr (BAnd (ev.message, 255)))));
  501.         {*******************}
  502.         NetWorkEvt: NetWorkScheduler.HandleMsg(MsgPtr(ev.message));
  503.         {*******************}
  504.         otherwise  begin
  505.         end;{otherwise}
  506.     end {case}
  507.     else begin
  508.         NetWorkScheduler.PeriodicTask;
  509.         If NlTask<>NoErr then ProgramBreak('Error in NlTask');
  510.     end;
  511. end;
  512.  
  513.  
  514. procedure initdefaults;
  515. begin
  516.     if spare then debugstr('RemoteJob initdefaults. Type g to continue.');
  517.     done    := false; 
  518.     mode    :=NextMode;
  519.  
  520.     JobFileToSend    :=cJobFileToSend;
  521.     JobFileReceived    :=cJobFileReceived;
  522.     gTextValid    :=false;
  523.     gTextToSend    :='';
  524.     with sendHeader do
  525.     begin
  526.         idStamp:=longint(cFormatVersion);    {this is version 1 format}
  527.         signature:=longint('MPS ');    {whom shall we activate ? default: MPW}
  528.         whereMode:=LocalMode;        {the recipient should launch it locally}
  529.     end;
  530. end;
  531.  
  532.  
  533. {run HandleEvents a small number of times to get the screen etc set up}
  534. procedure initialwakeup;
  535. var count:integer;
  536. begin
  537.     gSleep := 0;
  538.     for count:=1 to 6 do begin
  539.         NetWorkScheduler.Receiving:=true;
  540.         HandleEvents;
  541.     end;
  542. end;
  543.  
  544. {find requested sleep value. Polling all clients is a bad strategy here -
  545. in general, you will not know at programming time who might be active.
  546. However Apple recommends this poor strategy. So we follow it for this example}
  547.  
  548. procedure getSleep;
  549. var tempsleep:longint;
  550. begin
  551.     gSleep:=10;{my default maximum sleep value}
  552.     tempSleep:=NetWorkScheduler.GetSleep;
  553.     if tempSleep<gSleep then gSleep:=tempSleep;
  554.     tempSleep:=NLGetSleep;
  555.     if tempSleep<gSleep then gSleep:=tempSleep;
  556.     if gSleep<0 then gSleep:=0;
  557. end;
  558.  
  559. {=============================================================================}
  560. {        }
  561.  
  562. begin
  563.     InitToolBox; 
  564.     InitDefaults;
  565.     
  566.     if InitNetwork(NetWorkEvt)<>NoErr then halt;
  567.     if NlInit<>noErr then halt;
  568.  
  569.     New(NetWorkScheduler);            {Create and Install the scheduler}
  570.     NetWorkScheduler.Init;
  571.  
  572.     new(remoteHandler);     {create a remoteHandler and introduce it to the scheduler}
  573.     NetWorkScheduler.InitTaskHandler(remoteHandler);
  574.  
  575.     if master then begin    {create a remoteGenerator and introduce it to the scheduler}
  576.         new(remoteGenerator);
  577.         NetWorkScheduler.InitTaskGenerator(remoteGenerator);
  578.     end;
  579.  
  580.     initialwakeup;        {run HandleEvents a small number of times to get the screen etc set up}
  581.     gSleep:=60;
  582.  
  583.     repeat 
  584.         NetWorkScheduler.Receiving:=true;
  585.         getSleep;
  586.         HandleEvents;
  587.         if (not master) & (NetWorkScheduler.taskhandler.NrPendingMessages=0) 
  588.         then done:=true;
  589.         NetWorkScheduler.Sending:=NetWorkScheduler.taskgenerator<>nil;    {even if there was nothing now…}
  590.     until done;
  591.  
  592.     NetWorkScheduler.Free;
  593.     if NLExit<>noErr then halt;
  594.     if ExitNetWork <> NoErr then halt;
  595.     
  596. end.
  597.